home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
pnl010.zip
/
ERR_DESC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-03-01
|
3KB
|
102 lines
Unit Err_Desc;
(*Copyright (c) 1992 KHIRON Software
All rights reserved. KHIRON Software hereby grants
permission for free distribution of this software,
and for use of this software within commercial and
non-commercial applications. This software itself
may not be distributed commercially without obtaining
written permission from KHIRON Software.
Should you use this software or it's techniques in commercial
products send me a postcard at the following address to fulfill
a licensing commitment:
Richard A. Morris
C/- KHIRON Software
P.O. Box 544
INDOOROOPILLY Qld 4068
AUSTRALIA
*)
(*
This unit reads a stringlist made by Make_Err containing descriptions of
common Turbo Pascal run time errors. It then attempts to describe any
runtime errors that the program using this unit creates.
The unit will also use read ini to find the Path/Name of the Errors file.
*)
INTERFACE
Uses Objects,
ReadIni;
IMPLEMENTATION
Var
PreErrDesc_ExitProc: pointer;
FUNCTION Hex(w : Word) : STRING;
const
hexChars : array [0..$F] of Char =
'0123456789ABCDEF';
begin
hEX :=hexChars[Hi(w) shr 4]+hexChars[Hi(w) and $F]+
hexChars[Lo(w) shr 4]+hexChars[Lo(w) and $F];
END;
FUNCTION PTR2Str(p : POINTER) : STRING;
BEGIN
IF P = NIL THEN
PTR2Str := 'NIL'
else
PTR2Str := HEX(SEG(P^))+':'+HEX(OFS(P^));
END;
Function ErrorFor(ErrNumber : Word) : String;
Var
ErrorDesc : String;
ErrorStrings : pStringList;
ErrorStream : pStream;
ErrorResource: pResourceFile;
StreamName : fNameStr;
begin
StreamName := GetParam('System','ErrorFile');
If StreamName = '' then
ErrorFor := 'Errorfile Parameter missing from INI File'
else
begin
ErrorStream := New(pBufStream,Init(StreamName,stOpen,1024));
if ErrorStream = nil then
ErrorFor := 'ERRORS.STM missing'
else
begin
ErrorResource := New(pResourceFile,Init(ErrorStream));
ErrorStrings := pStringList(ErrorResource^.Get('ERRORDESC'));
if ErrorStrings = nil then
ErrorFor := 'ERRORS.STM invalid'
else
begin
if ErrorStrings^.Get(ErrNumber) = '' then
ErrorFor := 'Unknown Error'
else
ErrorFor := ErrorStrings^.Get(ErrNumber);
end;
end;
end;
end;
Procedure DescribeError; far;
begin
ExitProc := PreErrDesc_ExitProc;
if ExitCode = 0 then
ErrorAddr := nil
else
begin
Assign(OutPut,'');
Rewrite(Output);
Writeln('Run Time Error ',ExitCode);
Writeln(ErrorFor(ExitCode));
Writeln('at Location ',Ptr2Str(ErrorAddr));
ErrorAddr := nil;
end;
end;
begin
{Set Up ExitCode}
RegisterType(RStringList);
PreErrDesc_ExitProc := ExitProc;
ExitProc := @DescribeError;
end.